home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch17 / Polygon.cls < prev    next >
Text File  |  1999-07-06  |  17KB  |  565 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "RayPolygon"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = False
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. ' A polygon in a plane.
  17.  
  18. Implements RayTraceable
  19.  
  20. Private NumPoints As Integer
  21. Private Points() As Point3D ' Vertices
  22.  
  23. ' Ambient light parameters.
  24. Private AmbientKr As Single
  25. Private AmbientKg As Single
  26. Private AmbientKb As Single
  27.  
  28. ' Diffuse light parameters.
  29. Private DiffuseKr As Single
  30. Private DiffuseKg As Single
  31. Private DiffuseKb As Single
  32.  
  33. ' Specular reflection parameters.
  34. Private SpecularN As Single
  35. Private SpecularK As Single
  36.  
  37. ' Reflected light parameters.
  38. Private ReflectedKr As Single
  39. Private ReflectedKg As Single
  40. Private ReflectedKb As Single
  41.  
  42. ' Refracted light parameters.
  43. Private TransN As Single
  44. Private n1 As Single   ' Index of refraction outside the object.
  45. Private n2 As Single   ' Index of refraction inside the object.
  46. Private TransmittedKr As Single
  47. Private TransmittedKg As Single
  48. Private TransmittedKb As Single
  49.  
  50. Private IsReflective As Boolean
  51. Private IsTransparent As Boolean
  52. Private DoneOnThisScanline As Boolean
  53.  
  54. ' We had a hit on this scanline.
  55. Private HadHit As Boolean
  56.  
  57. ' We have had a hit on a previous scanline.
  58. Private HadHitOnPreviousScanline As Boolean
  59.  
  60. ' We will not be visible on later scanlines.
  61. Private ForeverCulled As Boolean
  62. ' Return an appropriate color for this object.
  63. Private Function GetColor() As Long
  64. Dim R As Integer
  65. Dim G As Integer
  66. Dim B As Integer
  67.  
  68.     R = 255 * (DiffuseKr + AmbientKr): If R > 255 Then R = 255
  69.     G = 255 * (DiffuseKg + AmbientKg): If G > 255 Then G = 255
  70.     B = 255 * (DiffuseKb + AmbientKb): If B > 255 Then B = 255
  71.     GetColor = RGB(R, G, B)
  72. End Function
  73. ' Return the right shade for this polygon.
  74. Private Function GetShade(ByVal pgon As SimplePolygon) As Long
  75. Dim i As Integer
  76. Dim px As Single
  77. Dim py As Single
  78. Dim pz As Single
  79. Dim light_source As LightSource
  80. Dim total_r As Single
  81. Dim total_g As Single
  82. Dim total_b As Single
  83. Dim R1 As Integer
  84. Dim g1 As Integer
  85. Dim b1 As Integer
  86. Dim empty_objects As Collection
  87.  
  88.     With pgon
  89.         ' Find a central point on this polygon.
  90.         For i = 1 To .PointX.Count
  91.             px = px + .PointX(i)
  92.             py = py + .PointY(i)
  93.             pz = pz + .PointZ(i)
  94.         Next i
  95.         px = px / .PointX.Count
  96.         py = py / .PointX.Count
  97.         pz = pz / .PointX.Count
  98.  
  99.         ' Add up the light components.
  100.         Set empty_objects = New Collection
  101.         For Each light_source In LightSources
  102.             CalculateHitColorDSA _
  103.                 1, empty_objects, Nothing, _
  104.                 EyeX, EyeY, EyeZ, _
  105.                 px, py, pz, .Nx, .Ny, .Nz, _
  106.                 DiffuseKr, DiffuseKg, DiffuseKb, AmbientKr, AmbientKg, AmbientKb, _
  107.                 SpecularK, SpecularN, R1, g1, b1
  108.             total_r = total_r + R1
  109.             total_g = total_g + g1
  110.             total_b = total_b + b1
  111.         Next light_source
  112.     End With
  113.  
  114.     If total_r > 255 Then total_r = 255
  115.     If total_g > 255 Then total_g = 255
  116.     If total_b > 255 Then total_b = 255
  117.  
  118.     GetShade = RGB(total_r, total_g, total_b)
  119. End Function
  120.  
  121. ' Return the unit surface normal.
  122. Private Sub GetUnitNormal(ByRef Nx As Single, ByRef Ny As Single, ByRef Nz As Single)
  123. Dim v1x As Single
  124. Dim v1y As Single
  125. Dim v1z As Single
  126. Dim v2x As Single
  127. Dim v2y As Single
  128. Dim v2z As Single
  129. Dim n_len As Single
  130.  
  131.     v1x = Points(2).Trans(1) - Points(1).Trans(1)
  132.     v1y = Points(2).Trans(2) - Points(1).Trans(2)
  133.     v1z = Points(2).Trans(3) - Points(1).Trans(3)
  134.     v2x = Points(3).Trans(1) - Points(2).Trans(1)
  135.     v2y = Points(3).Trans(2) - Points(2).Trans(2)
  136.     v2z = Points(3).Trans(3) - Points(2).Trans(3)
  137.     m3Cross Nx, Ny, Nz, v1x, v1y, v1z, v2x, v2y, v2z
  138.  
  139.     n_len = Sqr(Nx * Nx + Ny * Ny + Nz * Nz)
  140.     Nx = Nx / n_len
  141.     Ny = Ny / n_len
  142.     Nz = Nz / n_len
  143. End Sub
  144.  
  145. ' Return true if the point is in the polygon.
  146. Private Function PointInside(ByVal X As Single, ByVal Y As Single, ByVal Z As Single) As Boolean
  147. Dim i As Integer
  148. Dim xok As Boolean
  149. Dim yok As Boolean
  150. Dim zok As Boolean
  151.  
  152.     ' See in which coordinates the points differ.
  153.     ' X coordinates.
  154.     xok = False
  155.     For i = 2 To NumPoints
  156.         If Points(i - 1).Trans(1) <> Points(i).Trans(1) _
  157.         Then
  158.             xok = True
  159.             Exit For
  160.         End If
  161.     Next i
  162.  
  163.     ' Y coordinates.
  164.     yok = False
  165.     For i = 2 To NumPoints
  166.         If Points(i - 1).Trans(2) <> Points(i).Trans(2) _
  167.         Then
  168.             yok = True
  169.             Exit For
  170.         End If
  171.     Next i
  172.  
  173.     ' Z coordinates.
  174.     zok = False
  175.     For i = 2 To NumPoints
  176.         If Points(i - 1).Trans(3) <> Points(i).Trans(3) _
  177.         Then
  178.             yok = True
  179.             Exit For
  180.         End If
  181.     Next i
  182.  
  183.     ' Test the appropriate projection.
  184.     If xok And yok Then
  185.         PointInside = PointInsideXY(X, Y)
  186.     ElseIf yok And zok Then
  187.         PointInside = PointInsideYZ(Y, Z)
  188.     ElseIf xok And zok Then
  189.         PointInside = PointInsideXZ(X, Z)
  190.     Else
  191.         PointInside = False
  192.     End If
  193. End Function
  194. ' Add non-backface polygons to this collection.
  195. Public Sub RayTraceable_GetPolygons(ByRef num_polygons As Integer, polygons() As SimplePolygon, ByVal shaded As Boolean)
  196. Dim i As Integer
  197. Dim pgon As SimplePolygon
  198.  
  199.     ' Make a polygon.
  200.     Set pgon = New SimplePolygon
  201.  
  202.     ' Add points to the polygon.
  203.     For i = 1 To NumPoints
  204.         With Points(i)
  205.             pgon.AddPoint .Trans(1), .Trans(2), .Trans(3)
  206.         End With
  207.     Next i
  208.  
  209.     ' See if we are shaded.
  210.     If shaded Then
  211.         ' We are shaded. Get the right color.
  212.         pgon.ForeColor = GetShade(pgon)
  213.         pgon.FillColor = pgon.ForeColor
  214.     Else
  215.         ' We are not shaded. Use the normal colors.
  216.         pgon.ForeColor = vbBlack
  217.         pgon.FillColor = GetColor()
  218.     End If
  219.  
  220.     ' Add the polygon to the list.
  221.     num_polygons = num_polygons + 1
  222.     ReDim Preserve polygons(1 To num_polygons)
  223.     Set polygons(num_polygons) = pgon
  224. End Sub
  225. ' Draw a wireframe for this object.
  226. Public Sub RayTraceable_DrawWireFrame(ByVal pic As PictureBox)
  227. Dim i As Integer
  228.  
  229.     ' Use an appropriate color.
  230.     pic.ForeColor = GetColor()
  231.  
  232.     ' Draw the polygon.
  233.     With Points(NumPoints)
  234.         pic.CurrentX = .Trans(1)
  235.         pic.CurrentY = .Trans(2)
  236.     End With
  237.     For i = 1 To NumPoints
  238.         With Points(i)
  239.             pic.Line -(.Trans(1), .Trans(2))
  240.         End With
  241.     Next i
  242. End Sub
  243. ' Initialize the object using text parameters in
  244. ' a comma-delimited list.
  245. Public Sub SetParameters(ByVal txt As String)
  246. Dim i As Integer
  247.  
  248.     On Error GoTo PolygonParamError
  249.  
  250.     ' Read the parameters and initialize the object.
  251.     ' Geometry.
  252.     NumPoints = CInt(GetDelimitedToken(txt, ","))
  253.     ReDim Points(1 To NumPoints)
  254.  
  255.     For i = 1 To NumPoints
  256.         With Points(i)
  257.             .Coord(1) = CSng(GetDelimitedToken(txt, ","))
  258.             .Coord(2) = CSng(GetDelimitedToken(txt, ","))
  259.             .Coord(3) = CSng(GetDelimitedToken(txt, ","))
  260.             .Coord(4) = 1
  261.         End With
  262.     Next i
  263.  
  264.     ' Ambient light.
  265.     AmbientKr = CSng(GetDelimitedToken(txt, ","))
  266.     AmbientKg = CSng(GetDelimitedToken(txt, ","))
  267.     AmbientKb = CSng(GetDelimitedToken(txt, ","))
  268.  
  269.     ' Diffuse reflection.
  270.     DiffuseKr = CSng(GetDelimitedToken(txt, ","))
  271.     DiffuseKg = CSng(GetDelimitedToken(txt, ","))
  272.     DiffuseKb = CSng(GetDelimitedToken(txt, ","))
  273.  
  274.     ' Specular reflection.
  275.     SpecularN = CSng(GetDelimitedToken(txt, ","))
  276.     SpecularK = CSng(GetDelimitedToken(txt, ","))
  277.  
  278.     ' Reflected light.
  279.     ReflectedKr = CSng(GetDelimitedToken(txt, ","))
  280.     ReflectedKg = CSng(GetDelimitedToken(txt, ","))
  281.     ReflectedKb = CSng(GetDelimitedToken(txt, ","))
  282.     IsReflective = (ReflectedKr > 0) Or (ReflectedKg > 0) Or (ReflectedKb > 0)
  283.  
  284.     ' Transmitted light.
  285.     TransN = CSng(GetDelimitedToken(txt, ","))
  286.     n1 = CSng(GetDelimitedToken(txt, ","))
  287.     n2 = CSng(GetDelimitedToken(txt, ","))
  288.     TransmittedKr = CSng(GetDelimitedToken(txt, ","))
  289.     TransmittedKg = CSng(GetDelimitedToken(txt, ","))
  290.     TransmittedKb = CSng(GetDelimitedToken(txt, ","))
  291.     IsTransparent = (TransmittedKr > 0) Or (TransmittedKg > 0) Or (TransmittedKb > 0)
  292.  
  293.     ' The polygon is its own wire frame.
  294.  
  295.     Exit Sub
  296.  
  297. PolygonParamError:
  298.     MsgBox "Error initializing polygon parameters."
  299. End Sub
  300.  
  301. ' Apply a transformation matrix to the object.
  302. Public Sub RayTraceable_Apply(M() As Single)
  303. Dim i As Integer
  304.  
  305.     ' Transform the points.
  306.     For i = 1 To NumPoints
  307.         m3Apply Points(i).Coord, _
  308.              M, Points(i).Trans
  309.     Next i
  310. End Sub
  311. ' Apply a transformation matrix to the object.
  312. Public Sub RayTraceable_ApplyFull(M() As Single)
  313. Dim i As Integer
  314.  
  315.     ' Transform the points.
  316.     For i = 1 To NumPoints
  317.         m3ApplyFull Points(i).Coord, _
  318.                  M, Points(i).Trans
  319.     Next i
  320. End Sub
  321.  
  322. ' Draw the object with backfaces removed.
  323. ' Draw the whole wire frame for planes.
  324. Public Sub RayTraceable_DrawBackfacesRemoved(ByVal pic As PictureBox)
  325.     RayTraceable_DrawWireFrame pic
  326. End Sub
  327. ' Return the red, green, and blue components of
  328. ' the surface at the hit position.
  329. Public Sub RayTraceable_FindHitColor(ByVal depth As Integer, Objects As Collection, ByVal eye_x As Single, ByVal eye_y As Single, ByVal eye_z As Single, ByVal px As Single, ByVal py As Single, ByVal pz As Single, ByRef R As Integer, ByRef G As Integer, ByRef B As Integer)
  330. Dim Nx As Single
  331. Dim Ny As Single
  332. Dim Nz As Single
  333. Dim Vx As Single
  334. Dim Vy As Single
  335. Dim Vz As Single
  336. Dim NdotV As Single
  337.  
  338.     ' Find the unit normal at this point.
  339.     GetUnitNormal Nx, Ny, Nz
  340.  
  341.     ' Make sure the normal points towards the
  342.     ' center of projection.
  343.     Vx = EyeX - px
  344.     Vy = EyeY - py
  345.     Vz = EyeZ - pz
  346.     NdotV = Nx * Vx + Ny * Vy + Nz * Vz
  347.     If NdotV < 0 Then
  348.         Nx = -Nx
  349.         Ny = -Ny
  350.         Nz = -Nz
  351.     End If
  352.  
  353.     ' Get the hit color.
  354.     CalculateHitColor depth, Objects, Me, _
  355.         eye_x, eye_y, eye_z, _
  356.         px, py, pz, _
  357.         Nx, Ny, Nz, _
  358.         DiffuseKr, DiffuseKg, DiffuseKb, _
  359.         AmbientKr, AmbientKg, AmbientKb, _
  360.         SpecularK, SpecularN, _
  361.         ReflectedKr, ReflectedKg, ReflectedKb, IsReflective, _
  362.         TransmittedKr, TransmittedKg, TransmittedKb, TransN, n1, n2, IsTransparent, _
  363.         R, G, B
  364. End Sub
  365. ' See if the scanline plane with the indicated
  366. ' point and normal intersects this object.
  367. '
  368. ' Do not cull. Note that this may not be a
  369. ' convex polygon.
  370. Public Sub RayTraceable_CullScanline(ByVal px As Single, ByVal py As Single, ByVal pz As Single, ByVal Nx As Single, ByVal Ny As Single, ByVal Nz As Single)
  371.     DoneOnThisScanline = False
  372. End Sub
  373. ' Return the value T for the point of intersection
  374. ' between the vector from point (px, py, pz) in
  375. ' the direction <vx, vy, vz>.
  376. '
  377. ' direct_calculation is true if we are finding the
  378. ' intersection from a viewing position ray. It is
  379. ' false if we are finding an reflected intersection
  380. ' or a shadow feeler.
  381. Public Function RayTraceable_FindT(ByVal direct_calculation As Boolean, ByVal px As Single, ByVal py As Single, ByVal pz As Single, ByVal Vx As Single, ByVal Vy As Single, ByVal Vz As Single) As Single
  382. Dim A As Single
  383. Dim B As Single
  384. Dim C As Single
  385. Dim D As Single
  386. Dim Nx As Single
  387. Dim Ny As Single
  388. Dim Nz As Single
  389. Dim denom As Single
  390. Dim t As Single
  391. Dim X As Single
  392. Dim Y As Single
  393. Dim Z As Single
  394.  
  395.     ' See if we have been culled.
  396.     If direct_calculation And DoneOnThisScanline Then
  397.         RayTraceable_FindT = -1
  398.         Exit Function
  399.     End If
  400.  
  401.     ' Find the unit normal at this point.
  402.     GetUnitNormal Nx, Ny, Nz
  403.  
  404.     ' Compute the plane's parameters.
  405.     A = Nx
  406.     B = Ny
  407.     C = Nz
  408.     D = -(Nx * Points(1).Trans(1) + _
  409.           Ny * Points(1).Trans(2) + _
  410.           Nz * Points(1).Trans(3))
  411.  
  412.     ' If the denominator = 0, the ray is parallel
  413.     ' to the plane so there's no intersection.
  414.     denom = A * Vx + B * Vy + C * Vz
  415.     If denom = 0 Then
  416.         RayTraceable_FindT = -1
  417.         Exit Function
  418.     End If
  419.  
  420.     ' Solve for t.
  421.     t = -(A * px + B * py + C * pz + D) / denom
  422.  
  423.     ' If there is no positive t value, there's no
  424.     ' intersection in this direction.
  425.     If t < 0.01 Then
  426.         RayTraceable_FindT = -1
  427.         Exit Function
  428.     End If
  429.  
  430.     ' Get the point of intersection with the plane.
  431.     X = px + t * Vx
  432.     Y = py + t * Vy
  433.     Z = pz + t * Vz
  434.  
  435.     ' See if the point is in the polygon.
  436.     If Not PointInside(X, Y, Z) Then
  437.         ' We are not in the polygon.
  438.         RayTraceable_FindT = -1
  439.         Exit Function
  440.     End If
  441.  
  442.     ' We had a hit.
  443.     If direct_calculation Then HadHit = True
  444.  
  445.     RayTraceable_FindT = t
  446. End Function
  447. ' Return true if the point's projection lies within
  448. ' this polygon's projection onto the X-Y plane.
  449. Private Function PointInsideXY(ByVal X As Single, ByVal Y As Single) As Boolean
  450. Dim i As Integer
  451. Dim theta1 As Double
  452. Dim theta2 As Double
  453. Dim dtheta As Double
  454. Dim dx As Double
  455. Dim dy As Double
  456. Dim angles As Double
  457.  
  458.     dx = Points(NumPoints).Trans(1) - X
  459.     dy = Points(NumPoints).Trans(2) - Y
  460.     theta1 = ATan2(CSng(dy), CSng(dx))
  461.     If theta1 < 0 Then theta1 = theta1 + 2 * PI
  462.     For i = 1 To NumPoints
  463.         dx = Points(i).Trans(1) - X
  464.         dy = Points(i).Trans(2) - Y
  465.         theta2 = ATan2(CSng(dy), CSng(dx))
  466.         If theta2 < 0 Then theta2 = theta2 + 2 * PI
  467.         dtheta = theta2 - theta1
  468.         If dtheta > PI Then dtheta = dtheta - 2 * PI
  469.         If dtheta < -PI Then dtheta = dtheta + 2 * PI
  470.         angles = angles + dtheta
  471.         theta1 = theta2
  472.     Next i
  473.  
  474.     PointInsideXY = (Abs(angles) > 0.001)
  475. End Function
  476. ' Return true if the point's projection lies within
  477. ' this polygon's projection onto the X-Y plane.
  478. Private Function PointInsideXZ(ByVal X As Single, ByVal Z As Single) As Boolean
  479. Dim i As Integer
  480. Dim theta1 As Double
  481. Dim theta2 As Double
  482. Dim dtheta As Double
  483. Dim dx As Double
  484. Dim dz As Double
  485. Dim angles As Double
  486.  
  487.     dx = Points(NumPoints).Trans(1) - X
  488.     dz = Points(NumPoints).Trans(3) - Z
  489.     theta1 = ATan2(CSng(dz), CSng(dx))
  490.     If theta1 < 0 Then theta1 = theta1 + 2 * PI
  491.     For i = 1 To NumPoints
  492.         dx = Points(i).Trans(1) - X
  493.         dz = Points(i).Trans(3) - Z
  494.         theta2 = ATan2(CSng(dz), CSng(dx))
  495.         If theta2 < 0 Then theta2 = theta2 + 2 * PI
  496.         dtheta = theta2 - theta1
  497.         If dtheta > PI Then dtheta = dtheta - 2 * PI
  498.         If dtheta < -PI Then dtheta = dtheta + 2 * PI
  499.         angles = angles + dtheta
  500.         theta1 = theta2
  501.     Next i
  502.  
  503.     PointInsideXZ = (Abs(angles) > 0.001)
  504. End Function
  505. ' Return true if the point projection lies within
  506. ' this polygon's projection onto the X-Z plane.
  507. Private Function PointInsideYZ(ByVal Y As Single, ByVal Z As Single) As Boolean
  508. Dim i As Integer
  509. Dim theta1 As Double
  510. Dim theta2 As Double
  511. Dim dtheta As Double
  512. Dim dy As Double
  513. Dim dz As Double
  514. Dim angles As Double
  515.  
  516.     dy = Points(NumPoints).Trans(2) - Y
  517.     dz = Points(NumPoints).Trans(3) - Z
  518.     theta1 = ATan2(CSng(dz), CSng(dy))
  519.     If theta1 < 0 Then theta1 = theta1 + 2 * PI
  520.     For i = 1 To NumPoints
  521.         dy = Points(i).Trans(2) - Y
  522.         dz = Points(i).Trans(3) - Z
  523.         theta2 = ATan2(CSng(dz), CSng(dy))
  524.         If theta2 < 0 Then theta2 = theta2 + 2 * PI
  525.         dtheta = theta2 - theta1
  526.         If dtheta > PI Then dtheta = dtheta - 2 * PI
  527.         If dtheta < -PI Then dtheta = dtheta + 2 * PI
  528.         angles = angles + dtheta
  529.         theta1 = theta2
  530.     Next i
  531.  
  532.     PointInsideYZ = (Abs(angles) > 0.001)
  533. End Function
  534. ' Return the minimum and maximum distances from
  535. ' this point.
  536. ' Use the points.
  537. Private Sub RayTraceable_GetRminRmax(new_min As Single, new_max As Single, ByVal X As Single, ByVal Y As Single, ByVal Z As Single)
  538. Dim i As Integer
  539. Dim dx As Single
  540. Dim dy As Single
  541. Dim dz As Single
  542. Dim dist As Single
  543.  
  544.     new_min = 1E+30
  545.     new_max = -1E+30
  546.  
  547.     For i = 1 To NumPoints
  548.         With Points(i)
  549.             dx = X - .Trans(1)
  550.             dy = Y - .Trans(2)
  551.             dz = Z - .Trans(3)
  552.         End With
  553.         dist = Sqr(dx * dx + dy * dy + dz * dz)
  554.         If new_min > dist Then new_min = dist
  555.         If new_max < dist Then new_max = dist
  556.     Next i
  557. End Sub
  558. ' Reset the ForeverCulled flag.
  559. Private Sub RayTraceable_ResetCulling()
  560.     ForeverCulled = False
  561.     HadHitOnPreviousScanline = False
  562. End Sub
  563.  
  564.  
  565.